;; network.scm - (c) rohan drape, 2002-2005

;; Return the integer given by the IPV4 dotted notation host name at
;; the <string> `s'.  This is equivalent to inet_pton.

(define (host-name->host-address s)
  (fold + 0 (map (lambda (i n)
		   (arithmetic-shift (string->number i) n))
		 (string-tokenizeC s #\.)
		 '(24 16 8 0))))

;; Return a string in IPV4 dotted notation representing the <integer>
;; `i'.  This is equivalent to inet_ntop.  The integer must be able to
;; be represented in 32 bits.

(define (host-address->host-name i)
  (if (or (< i 0) (> i 4294967295))
      (error "host-address->host-name: illegal value" i))
  (format "~a.~a.~a.~a"
	  (bitwise-and (arithmetic-shift i -24) 255)
	  (bitwise-and (arithmetic-shift i -16) 255)
	  (bitwise-and (arithmetic-shift i -08) 255)
	  (bitwise-and (arithmetic-shift i -00) 255)))

;; A <network-address> associates a host-address with a port-number.

(define-structure network-address (host-address port-number))

;; Memoized constructor to allow <network-address> values to be used
;; in ordinary hash tables.

(defineV make-network-address
  (memoize-two 
   (lambda (host-address port-number)
     (make-network-address* host-address port-number))))

;; Construct a <network-address> from a <string> host-name.

(define (resolve-network-address host-name port-number)
  (make-network-address (host-name->host-address host-name) port-number))

;; Equality predicate.

(define (network-address-equal? a b)
  (and (= (network-address-host-address a) (network-address-host-address b))
       (= (network-address-port-number a) (network-address-port-number b))))

;; Accessor with translator.

(define (network-address-host-name a)
  (host-address->host-name (network-address-host-address a)))

;; Printer.

(define (network-address-display a)
  (display
   (format
    "Host-Name: ~a, Port-Number: ~a"
    (host-address->host-name (network-address-host-address a))
    (network-address-port-number a))))
